home *** CD-ROM | disk | FTP | other *** search
/ Aminet 39 / Aminet 39 (2000)(Schatztruhe)[!][Oct 2000].iso / Aminet / dev / basic / ImageDTInfo.lha / ImageDTInfo / ImageDTInfo.bas < prev    next >
Encoding:
BASIC Source File  |  2000-08-18  |  4.6 KB  |  152 lines
  1. ' ===========================================================================
  2. '  ImageDTInfo by © 1999-2000 Dámaso D. Estévez
  3. '     Fido : 2:348/613.44
  4. '     Inet : amidde@arrakis.es
  5. '      WWW : http://www.arrakis.es/~amidde/
  6. '
  7. ' ImageDTInfo.bas (main code/código principal)
  8. '
  9. '   For to compile this, use the compiler prefs file "HBCImageDTInfo.opts"
  10. '           (the `Tokens.t' file IS NEEDED for to compile this code...
  11. '      except if you include the `Tokens.bas' code in this code at start).
  12. '                                 -----------
  13. '         Para compilar este programa utilice el fichero de prefencias
  14. '         del compilador "HBCImageDTInfo.opts" (el fichero `Tokens.t'
  15. '                ES NECESARIO para poder compilar el programa...
  16. '   salvo si incluye el código de `Tokens.bas' al inicio de este código :D).
  17. ' ===========================================================================
  18. '      Created for use with FWCalendar Arexx script written by Ron Goertz
  19. '         and as a little coding exercise with (Hisoft|Maxon) Basic 2.
  20. '             You can re-use freely this code in your own works.
  21. '                                ------------
  22. '        Creado para usar con el guión ARexx FWCalendar de Ron Goertz
  23. '   y como un pequeño ejercicio de programación con (Hisoft|Maxon) Basic 2.
  24. '        Puede reutilizar libremente este código en sus producciones.
  25. ' ===========================================================================
  26.  
  27. ' ------------- Opening libraries -------------
  28. ' -- (OS datatypes system appears from v39) ---
  29.  
  30. ' ---------- Apertura de bibliotecas ----------
  31. ' --- (el sistema de tipos de datos aparece ---
  32. ' --- a partir de la versión 39 del S.O. ;) ---
  33. ' ---------------------------------------------
  34.  
  35. ' CacheClearE()
  36. LIBRARY OPEN "exec.library",39&
  37.  
  38. ' OpenCatalogA(), CloseCatalog()
  39. LIBRARY OPEN "locale.library",39&
  40.  
  41. ' ----- Locale support ------
  42. ' ---- Prestación local -----
  43. ' ---------------------------
  44. DIM SHARED localeInfo&(2)
  45. localeInfo&(0) = LIBRARY("locale.library")
  46. IF localeInfo&(0) <> NULL& THEN
  47.     localeInfo&(1) = OpenCatalogA&(NULL&, SADD("ImageDTInfo.catalog" + CHR$(0)), NULL&)
  48. END IF
  49.  
  50. REM $include BH:BLib/GetCString.bas
  51. REM $include Locale/ImageDTInfo_Locale.bc
  52. REM $include Locale/ImageDTInfo_Locale.bas
  53.  
  54. FUNCTION CadLc$(BYVAL id&)
  55.     CadLc$ = PEEK$(GetCString&(VARPTR(localeInfo&(0)),id&))
  56. END FUNCTION
  57.  
  58. ' - Loading my modules with functions/subroutines -
  59. ' - Cargando mis módulos con funciones/subrutinas -
  60. ' -------------------------------------------------
  61. REM $include AuxRoutines/GetArg.bas
  62. REM $include AuxRoutines/InfoImgFile.bas
  63.  
  64. ' --------- Shared vars for error handling --------
  65. ' -- Variables compartidas de gestión de errores --
  66. ' -------------------------------------------------
  67. en& = 0&
  68. em$ = ""
  69.  
  70. ' ---- Calling the main routine ----
  71. ' - Llamando a la rutina principal -
  72. ' ----------------------------------
  73. CALL main(COMMAND$)
  74.  
  75. IF LIBRARY("locale.library") <> NULL& THEN
  76.         CloseCatalog localeInfo&(1)
  77. END IF
  78.  
  79. LIBRARY CLOSE "exec.library"
  80.  
  81. END
  82.  
  83. '   =====================================================================
  84. '                    "Main"subroutine / Sub-rutina "Main"
  85. '   =====================================================================
  86.  
  87. SUB main(cad$) SHARED en&,em$
  88. LOCAL tmp$,version$
  89.  
  90.     ' -- Variables initialization ---
  91.     ' - Inicialización de variables -
  92.     '--------------------------------
  93.  
  94.     ' Copyright string / Cadena de autoría
  95.     version$ ="$VER: ImageDTInfo 1.51 (18.8.00) © Dámaso D. Estévez <amidde@arrakis.es>"
  96.  
  97.     ' ---- Asking the first argument ----
  98.     ' - Solicitando el primer argumento -
  99.     ' -----------------------------------
  100.     cad$=getarg$(cad$,1)
  101.  
  102.     ' - There is the argument? -
  103.     ' ---- ¿Hay argumento? -----
  104.     ' --------------------------
  105.     IF cad$<>"" THEN
  106.  
  107.         tmp$=InfoImgFile$(cad$)
  108.  
  109.         IF tmp$<>"" AND en&=0 AND em$="" THEN
  110.  
  111.             PRINT tmp$
  112.  
  113.         ELSE
  114.  
  115.             ' --------- If there was some error, -----------
  116.             ' ------ prints the error code (& message) -----
  117.  
  118.             ' - Si se ha producido algún error, se imprime -
  119.             ' ------ el código (y el mensaje de error) -----
  120.             ' ----------------------------------------------
  121.  
  122.             PRINT CadLc$(ERROR_TITLE&);
  123.             IF en&<>0 THEN
  124.                 PRINT " - ";CadLc$(ERROR_CODE_INFO&);": ";en&
  125.             ELSE
  126.                 PRINT
  127.             END IF
  128.  
  129.             PRINT CadLc$(ERROR_ARG_INFO&)": `";cad$;"'"
  130.  
  131.             IF em$<>"" THEN
  132.                 PRINT em$
  133.             END IF
  134.  
  135.         END IF
  136.  
  137.     ELSE
  138.  
  139.         ' -------- The user didn't include a filename as argument ----------
  140.         ' - El usuario no ha incluído un nombre de fichero como argumento --
  141.         ' ------------------------------------------------------------------
  142.         PRINT
  143.  
  144.         PRINT RIGHT$(version$,LEN(version$)-6)
  145.         PRINT
  146.         PRINT CadLc$(ERROR_ONLY_ONE_ARG&)
  147.         PRINT
  148.  
  149.     END IF
  150.  
  151. END SUB
  152.